The X-Philes (2nd Revision)/The X-Philes Number 1 (1995).iso/xphiles/hp48hor1/morse.src

Text File | 1991-02-21 | 4KB | 112 lines

%%HP: T(3)A(D)F(.);
@ MORSE
@ by Andrew Delano
DIR
  \->MRS
    \<< \->STK "" 'CODE' STO
      DO
        CASE DUP "A" SAME
          THEN dot bar end DROP " *- " CSTO
          END DUP "B" SAME
          THEN bar dot dot dot end DROP " -*** " CSTO
          END DUP "C" SAME
          THEN bar dot bar dot end DROP " -*-* " CSTO
          END DUP "D" SAME
          THEN bar dot dot end DROP " -** " CSTO
          END DUP "E" SAME
          THEN dot end DROP " * " CSTO
          END DUP "F" SAME
          THEN dot dot bar dot end DROP " **-* " CSTO
          END DUP "G" SAME
          THEN bar bar dot end DROP " --* " CSTO
          END DUP "H" SAME
          THEN dot dot dot dot end DROP " **** " CSTO
          END DUP "I" SAME
          THEN dot dot end DROP " ** " CSTO
          END DUP "J" SAME
          THEN dot bar bar bar end DROP " *--- " CSTO
          END DUP "K" SAME
          THEN bar dot bar end DROP " -*- " CSTO
          END DUP "L" SAME
          THEN dot bar dot dot end DROP " *-** " CSTO
          END DUP "M" SAME
          THEN bar bar end DROP " -- " CSTO
          END DUP "N" SAME
          THEN bar dot end DROP " -* " CSTO
          END DUP "O" SAME
          THEN bar bar bar end DROP " --- " CSTO
          END DUP "P" SAME
          THEN dot bar bar dot end DROP " *--* " CSTO
          END DUP "Q" SAME
          THEN bar bar dot bar end DROP " --*- " CSTO
          END DUP "R" SAME
          THEN dot bar dot end DROP " *-* " CSTO
          END DUP "S" SAME
          THEN dot dot dot end DROP " *** " CSTO
          END DUP "T" SAME
          THEN bar end DROP " - " CSTO
          END DUP "U" SAME
          THEN dot dot bar end DROP " **- " CSTO
          END DUP "V" SAME
          THEN dot dot dot bar end DROP " ***- " CSTO
          END DUP "W" SAME
          THEN dot bar bar end DROP " *-- " CSTO
          END DUP "X" SAME
          THEN bar dot dot bar end DROP " -**- " CSTO
          END DUP "Y" SAME
          THEN bar dot bar bar end DROP " -*-- " CSTO
          END DUP "Z" SAME
          THEN bar bar dot dot end DROP " --** " CSTO
          END DUP " " SAME
          THEN end end end DROP "SPC" CSTO
          END DUP "1" SAME
          THEN dot bar bar bar bar end DROP " *---- " CSTO
          END DUP "2" SAME
          THEN dot dot bar bar bar DROP " **--- " CSTO
          END DUP "3" SAME
          THEN dot dot dot bar bar end DROP " ***-- " CSTO
          END DUP "4" SAME
          THEN dot dot dot dot bar end DROP " ****- " CSTO
          END DUP "5" SAME
          THEN dot dot dot dot dot end DROP " ***** " CSTO
          END DUP "6" SAME
          THEN bar dot dot dot dot end DROP " -**** " CSTO
          END DUP "7" SAME
          THEN bar bar dot dot dot end DROP " --*** " CSTO
          END DUP "8" SAME
          THEN bar bar bar dot dot end DROP " ---** " CSTO
          END DUP "9" SAME
          THEN bar bar bar bar dot end DROP " ----* " CSTO
          END DUP "0" SAME
          THEN bar bar bar bar bar end DROP " ----- " CSTO
          END DUP "." SAME
          THEN dot bar dot bar dot bar end DROP " *-*-*- " CSTO
          END DUP "," SAME
          THEN bar bar dot dot bar bar end DROP " --**-- " CSTO
          END
        END
      UNTIL DEPTH 0 ==
      END
    \>>
  ALPH ""
  CODE ""
  \->STK
    \<< 'ALPH' STO ALPH SIZE 'B' STO
      DO ALPH B DUP SUB B 1 - 'B' STO
      UNTIL B 0 ==
      END 'B' PURGE
    \>>
  bar
    \<< 660 .25 BEEP .01 WAIT
    \>>
  dot
    \<< 660 .125 BEEP .01 WAIT
    \>>
  end
    \<< .025 WAIT
    \>>
  CSTO
    \<< CODE SWAP + 'CODE' STO
    \>>
END